unit qstfilecreator; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, {LResources, Forms,} Controls, Graphics, Dialogs,
  StdCtrls, {ZipFile,} Setup, {ctypes, } ziputils, {unzip,} zip;

type
  
  { TMainform }

  TMainform = class ( TForm )
   Button1 : TButton;
   Button2 : TButton;
   Button3 : TButton;
   ListBox1 : TListBox;
   OpenDialog1 : TOpenDialog;
   SaveDialog1 : TSaveDialog;
   //ZipFile1: TZipFile;
   procedure Button1Click ( Sender : TObject ) ;
   procedure Button2Click ( Sender : TObject ) ;
   procedure Button3Click ( Sender : TObject ) ;
   procedure saveqstfile;
  private
    { private declarations }
  public
    { public declarations }
  end;

//const
  //WRITEBUFFERSIZE = Z_BUFSIZE;
  //MAXFILENAME     = Z_MAXFILENAMEINZIP;

//type

{TLZip }
{
  TLZip = Class
    Public
      constructor Create(fZip : String);
      function AddFileFromDisk( filename : String ) : Integer;
      function UnCompress : boolean;
      function Files: TStringList;
    Private
      function zClose : Integer;
      function zOpen : Integer;
      function uClose : Integer;
      function uOpen : Integer;

      zf: zipFile;
      uzf : unzFile;

      zfi: zip_fileinfo;
      ufi: unz_file_info;
      opt_compress_level: longint;
      opt_overwrite: longint;
      err: longint;
      fileZip : String;
  End;} 

var
  Mainform : TMainform;

implementation

{ TLZip }

(*
constructor TLZip.Create(fZip : String);
begin
  zf := nil;
  uzf := nil;
  fileZip:=fZip;
  opt_overwrite := 0;
  opt_compress_level := Z_DEFAULT_COMPRESSION;
end;

function TLZip.zOpen : Integer;
begin
  if FileExists(fileZip) then
    zf := zipOpen(PChar(fileZip), 1)
  else
    zf := zipOpen(PChar(fileZip), 0);

  if zf = nil then
    zOpen := ZIP_ERRNO
  else
    zOpen := 0 ;
end;

function TLZip.zClose : Integer;
begin
  zClose := zipClose(zf, nil);
  if (zClose <> ZIP_OK) then
    DebugLn('error in closing ', fileZip);
end;

function TLZip.uOpen : Integer;
begin
  uzf := unzOpen(PChar(fileZip));

  if zf = nil then
    uOpen := ZIP_ERRNO
  else
    uOpen := 0 ;
end;

function TLZip.uClose : Integer;
begin
  uClose := unzClose(uzf);
  if (uClose <> ZIP_OK) then
    DebugLn('error in closing ', fileZip);
end;

function TLZip.AddFileFromDisk(filename : String) : Integer;
var
  buf: pointer;
  filenameinzip: PChar;
  fin: FILEptr;
  size_buf, size_read : longint;
begin
  AddFileFromDisk := 0;
  err := 0;

  if (filename='') then
    begin
      AddFileFromDisk := 0;
      exit;
    end;

  // Reservamos nuestro espacio en memoria
  size_buf := WRITEBUFFERSIZE;
  buf := AllocMem(size_buf);
  if (buf = nil) then
    begin
      DebugLn('Error allocating memory');
      AddFileFromDisk := ZIP_INTERNALERROR;
      exit;
    end;

  //if (opt_overwrite = 0) then
    //if FileExists(fileZip) then
      //if MessageDlg ('Warning!', 'The file ' + fileZip + ' exist. Overwrite ?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
          //zip_stat := 0;

  zOpen;
  filenameinzip := PChar(filename + #0);

  if (opt_compress_level <> 0) then
    err := zipOpenNewFileInZip(zf, filenameinzip, @zfi, nil, 0, nil, 0, nil { comment}, Z_DEFLATED, opt_compress_level)
  else
    err := zipOpenNewFileInZip(zf, filenameinzip, @zfi, nil, 0, nil, 0, nil, 0, opt_compress_level);

  if (err <> ZIP_OK) then
    DebugLn('error in opening ', filenameinzip, ' in zipfile')
  else
    begin
      fin := fopen(filenameinzip, fopenread);
      if (fin = nil) then
        begin
          err := ZIP_ERRNO;
          DebugLn('error in opening ', filenameinzip, ' for reading');
        end;

      if (err = ZIP_OK) then
        repeat
          err := ZIP_OK;
          size_read := fread(buf, 1, size_buf, fin);

          if (size_read < size_buf) then
            if feof(fin) = 0 then
              begin
                DebugLn('error in reading ', filenameinzip);
                err := ZIP_ERRNO;
              end;

          if (size_read > 0) then
            begin
              err := zipWriteInFileInZip(zf, buf, size_read);
              if (err < 0) then
                DebugLn('error in writing ', filenameinzip, ' in the zipfile');
            end;
        until (err <> ZIP_OK) or (size_read = 0);

      fclose(fin);
    end;

  if (err < 0) then
    err := ZIP_ERRNO
  else
    begin
      err := zipCloseFileInZip(zf);
      if (err <> ZIP_OK) then
        DebugLn('error in closing ', filenameinzip, ' in the zipfile');
    end;

  FreeMem(buf); {FreeMem(buf, size_buf);}
  zClose;
end;

function TLZip.UnCompress : boolean;
begin
  UnCompress := true;
end;

function LeadingZero(w: word): string;
var
  s: string;
begin
  Str(w: 0, s);
  if Length(s) = 1 then
    s := '0' + s;
  LeadingZero := s;
end;

function HexToStr(w: clong): string;
const
  ByteToChar: array[0..$F] of char = '0123456789ABCDEF';
var
  s: string;
  i: cint;
  x: clong;
begin
  s := '';
  x := w;
  for i := 0 to 3 do
  begin
    s := ByteToChar[byte(x) shr 4] + ByteToChar[byte(x) and $F] + s;
    x := x shr 8;
  end;
  HexToStr := s;
end;

function TLZip.Files: TStringList;
var
  i: longword;
  gi: unz_global_info;
  filename_inzip: array[0..255] of char;
  file_info: unz_file_info;
  ratio: longword;
  string_method: string[255];
  iLevel: cuInt;
begin
  Files := TStringList.Create;
  uOpen;
  err := unzGetGlobalInfo(self.uzf, gi);
  if (err <> UNZ_OK) then
    DebugLn('error ' + IntToStr(err) + ' with zipfile in unzGetGlobalInfo');
  for i := 0 to gi.number_entry - 1 do
    begin
      ratio := 0;
      err   := unzGetCurrentFileInfo(self.uzf, @file_info, filename_inzip, sizeof(filename_inzip), nil, 0, nil, 0);
      if (err <> UNZ_OK) then
        begin
          DebugLn('error ' + IntToStr(err) + ' with zipfile in unzGetCurrentFileInfo');
          break;
        end;
      Files.Append( filename_inzip);
      if ((i + 1) < gi.number_entry) then
        begin
          err := unzGoToNextFile(self.uzf);
          if (err <> UNZ_OK) then
            begin
              DebugLn('error ' + IntToStr(err) + ' with zipfile in unzGoToNextFile');
              break;
            end;
        end;
    end;
  uClose;
end;

*) 

{ TMainform }

procedure TMainform.Button1Click ( Sender : TObject ) ;
begin
  if opendialog1.Execute then begin
    listbox1.Items.addstrings(Opendialog1.Files);
  end;
end;

procedure TMainform.Button2Click ( Sender : TObject ) ;
var i : integer;
begin
  i :=  listbox1.ItemIndex;
  if i <> -1 then  begin
    Listbox1.Items.Delete(i);
    if i < listbox1.Count then 
      listbox1.Itemindex := i;
  end;  
end;

procedure TMainform.Button3Click ( Sender : TObject ) ;
var i : integer;

begin
  if pos('.csv',lowercase(listbox1.Items.Text)) > 0 then begin
    for i := 0 to listbox1.items.count -1 do 
      if pos('.csv',lowercase(listbox1.Items.Strings[i])) > 0 then 
      CSVFileName := listbox1.Items.strings[i];
       
    setupform.FormShow;
    if not setupform.cancelled then
      saveqstfile;
  end 
  else
    showmessage('Please add a questionnaire data file (.csv)');


  { 
  if not fileexists('empty.qst') then 
  begin 
    ShowMessage('Empty.qst not found! Aborting...'); 
    exit; 
  end; 
  if savedialog1.Execute then begin
    if pos('.csv',lowercase(listbox1.Items.Text)) > 0 then begin
      memstream := TMemoryStream.Create;
      CopyFile('empty.qst',savedialog1.FileName,false); 
      Zipfile1.FileName := savedialog1.FileName ;
      Zipfile1.Activate;
      
      // This alone did not work
      for i := 0 to listbox1.Count -1 do      
        Zipfile1.AppendFileFromDisk(listbox1.Items[i],extractfilename(listbox1.Items[i])) ;
      
      // So we load the files again, and update them with the content
      (*
      for i := 0 to listbox1.Count -1 do begin
        memstream.Clear;
        memstream.LoadFromFile(listbox1.Items[i]) ;
        Zipfile1.UpdateFile(memstream,extractfilename(listbox1.items[i]));
      end;
      *)
      
      showmessage('QST file created.');
      if messagedlg(Application.Title,'Create another?',mtconfirmation,[mbYes,mbNo],0) = mrNo then 
        Application.terminate;
    end
    else
      showmessage('Please add a questionnaire data file (.csv)');
  end;
  } 
end;

procedure TMainform.saveqstfile;
var     memstream : TMemoryStream;
        i : integer;
        testname : string;
        path : string;
        filezip : string;
        //newzip : TLZip;
        zf : ZipFile;
        zfi: zip_fileinfo;
        //ufi: unz_file_info;
        fin: FILEptr;
        buf: pointer;
        filenameinzip: PChar;
        filenameoutside : PChar; 
        size_buf, size_read : longint;
        err : integer;
      
begin
  if not fileexists('empty.qst') then 
  begin 
    ShowMessage('Empty.qst not found! Aborting...'); 
    exit; 
  end;
  testname := ChangeFileExt(ExtractFileName(CSVFilename),'');
  savedialog1.filename := testname;
  if savedialog1.Execute then begin
    if pos('.csv',lowercase(listbox1.Items.Text)) > 0 then begin
      while lowercase(testname) <> lowercase(ChangeFileExt(ExtractFileName(savedialog1.FileName),'')) do
      begin
        Showmessage('The questionnaire file (.qst) and the .csv file must be the same.');
        if not savedialog1.execute then exit;
      end;

      memstream := TMemoryStream.Create;

      // Starting from an existing zip file, because somehow creating a new one didn't work
      path := extractfilepath(Application.ExeName);
      if path[length(path)] = pathdelim then path := path + pathdelim;
      {CopyFile(path + 'empty.qst',savedialog1.FileName,false);
      Zipfile1.FileName := savedialog1.FileName ;
      Zipfile1.Activate;}
      //newzip := TLZip.create(savedialog1.filename);
      filezip := savedialog1.filename; 
      zf := zipOpen(PChar(fileZip), 0);
      
      // Add the .ini file into the file
      listbox1.items.add('Settings.ini');
      
      // Load the files into the zip file
      for i := 0 to listbox1.Count -1 do begin
        //Zipfile1.AppendFileFromDisk(listbox1.Items[i],extractfilename(listbox1.Items[i])) ;
        {memstream.Clear;
        memstream.LoadFromFile(Listbox1.Items[i]);
        Zipfile1.AppendStream(MemStream,extractfilename(listbox1.Items[i]),now());}
        //newzip.AddFileFromDisk( listbox1.Items[i]);

        filenameinzip := PChar(extractfilename(listbox1.Items[i]) + #0);
        filenameoutside := PChar(listbox1.Items[i] + #0);
        zipOpenNewFileInZip(zf, filenameinzip, @zfi, nil, 0, nil, 0, nil, 0, 0);
        
        fin := fopen(filenameoutside, fopenread);
        if (fin = nil) then
        begin
          err := ZIP_ERRNO;
          //DebugLn('error in opening ', filenameinzip, ' for reading');
        end;

        if (err = ZIP_OK) then
        repeat
          err := ZIP_OK;
          size_read := fread(buf, 1, size_buf, fin);

          if (size_read < size_buf) then
            if feof(fin) = 0 then
              begin
                //DebugLn('error in reading ', filenameinzip);
                err := ZIP_ERRNO;
              end;

          if (size_read > 0) then
            begin
              err := zipWriteInFileInZip(zf, buf, size_read);
              if (err < 0) then
                //DebugLn('error in writing ', filenameinzip, ' in the zipfile');
            end;
        until (err <> ZIP_OK) or (size_read = 0);

        fclose(fin);
        zipCloseFileInZip(zf);

      end; // For Loop 
      // Remove the temporary Settings.ini file

      zipClose(zf, nil);

      showmessage('QST file created.');
      if messagedlg(Application.Title,'Create another?',mtconfirmation,[mbYes,mbNo],0) = mrNo then 
        Application.terminate;
      listbox1.Items.Clear;
    end
    else
      showmessage('Please add a questionnaire data file (.csv)');
  end;
end; 

initialization
  {$I qstfilecreator.lrs}

end.
